{-# LANGUAGE OverloadedStrings,InstanceSigs,TupleSections,RecordWildCards,DeriveFunctor#-}
{-# LANGUAGE QuasiQuotes,MultiParamTypeClasses,ScopedTypeVariables,FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell,TypeFamilies,FlexibleInstances,DeriveGeneric #-}
module App.Article.Manager (newCate,deleteCate,getAllCate,updateArticle,getCateInfo,isCanShowArticle,
                            queryArticle,deleteArticle,getArticle,getNewsArticle,getTailCateAndArticle,
                            getCateNode,findTree,CateNode(..),addArticle,queryCate,queryArticleList) where
import App.Common.Types
import App.Article.DB
import Control.Monad.Trans.Except
import Control.Error.Util
import qualified Data.Text as T
import qualified App.Common.DataTypes as DT
import Database.Persist
import Database.Persist.Sqlite
import Control.Monad.Trans
import Data.Int
import Data.Maybe
import Control.Error.Safe
import Data.Aeson
import GHC.Generics (Generic)
import App.Common.Table
import Data.Time
import Data.Default
import Data.Either
data CateNode a = CateNode
  {
      text::a
     ,nodes::[CateNode a]
     ,cateId::Int64
     ,catePid::Int64
  }
 deriving (Show,Generic,Functor)
instance ToJSON (CateNode T.Text)

--instance Functor CateNode where

entity2Tuple::Entity ArticleCate -> (Int64,ArticleCate)
entity2Tuple (Entity k val) = (fromSqlKey k,val)


newCate::(WebAppM m) => T.Text -> Int64 -> m (Either T.Text (Int64,ArticleCate))
newCate cateName pid = runExceptT $ do
    let convName = DT.convWebSafeText cateName
    now <- liftIO $ getCurrentTime
    let newCate  = ArticleCate convName pid now
    let pk::Key ArticleCate = toSqlKey pid
    mPArtice <- lift $ runDB $ get pk
    tryAssert "父分类不存在" (isJust mPArtice || pid == -1)
    ret <-    lift $ runDB $ insert newCate
    return (fromSqlKey ret,newCate)

deleteCate::(SqlDB m) => Int64 -> m (Either T.Text ())
deleteCate cateId = runExceptT $ do
  let k::Key ArticleCate = toSqlKey cateId
  delChild::[Entity ArticleCate] <- lift $ runDB $ selectList [ArticleCateParentId ==. cateId] []
  tryAssert "不能删除有子分类的分类" ((length delChild) == 0)
  lift $ runDB $ delete k
  return ()

getAllCate::(SqlDB m) => m [(Int64,ArticleCate)]
getAllCate = do
  cateLst::[Entity ArticleCate] <- runDB $ selectList [] []
  return $ map entity2Tuple cateLst

queryCate::(SqlDB m) => Int64 -> m [(Int64,ArticleCate)]
queryCate cid = do
  lst <- runDB $ selectList [ArticleCateParentId ==. cid] [Asc ArticleCateCreateTime]
  return $ map entity2Tuple lst

isTailCate::Int64 -> [(Int64,ArticleCate)] -> Bool
isTailCate cateId allCate = (== 0).length $ filter (\(id,ArticleCate{..}) -> articleCateParentId == cateId) allCate

getTailCate::[(Int64,ArticleCate)] -> [(Int64,ArticleCate)]
getTailCate allCate =  filter (\(id,_)-> isTailCate id allCate) allCate

getCateNode::(WebAppM m) => m (CateNode T.Text)
getCateNode = do
  cateList <- getAllCate
  let nodes = findTree (-1) cateList
  return $ CateNode "顶级菜单" nodes (-1) (-1)

getCateInfo::(SqlDB m) => Int64 -> m (Either T.Text (Int64,ArticleCate))
getCateInfo cid = runExceptT $ do
  mayCate <- lift $ runDB $ get $ toSqlKey cid
  case mayCate of
    Nothing    -> throwE $ T.pack $ "不存在的CateId" <> (show cid)
    Just cate  -> return $ (cid,cate)

getTailCateAndArticle::(SqlDB m) => Maybe Int64 -> Int64 -> m [((Int64,ArticleCate),[(Int64,Article)])]
getTailCateAndArticle mayUserId limitLen = do
  lstCate <- getAllCate
  let tailCate = getTailCate lstCate
  runDB $ mapM takeArticle tailCate
 where
  --takeArticle::(SqlDB m) => (Int64,ArticleCate) -> m ((Int64,ArticleCate),[(Int64,Article)])
  takeArticle sCate@(id,cate) = do
      curArticle <- selectList ([ArticleOwnerCateId ==. id] <> filterPrivateArticle mayUserId) [Desc ArticleCreateTime,LimitTo $ fromIntegral limitLen]
      return (sCate,map eu2tp curArticle)
{-
                 -1
        1        2        3 
    11   12   21  22   31    32
-}
findTree::Int64 -> [(Int64,ArticleCate)] -> [CateNode T.Text]
findTree pid lst = map cLst2CateNode curList
        where
          cLst2CateNode (curId,v) = CateNode (articleCateName v) (findTree curId lst) curId pid
          curList = filter (\(k,v) -> (articleCateParentId v) == pid) lst

addArticle::(SqlDB m) => T.Text -> T.Text -> Int64 -> Int64 -> Bool -> m (Either T.Text Int64)
addArticle title context pid userId isPrivate = runExceptT $ do
  let pk::Key ArticleCate = toSqlKey pid
  mPArtice <- lift $ runDB $ get pk
  tryAssert (T.pack (show pid) <> "父分类不存在") (isJust mPArtice)
  now <- liftIO  getCurrentTime
  let newArticle = Article title context pid now userId isPrivate
  key <- lift $ runDB $ insert newArticle
  liftIO $ print key
  return (fromSqlKey key)

updateArticle::(SqlDB m) => Int64 -> T.Text -> T.Text -> Int64 -> Bool -> m (Either T.Text Int64)
updateArticle editId title context pid  isPrivate = runExceptT $ do
  let upKey::Key Article = toSqlKey editId
  mPArtice <- lift $ runDB $ get upKey
  tryAssert ((T.pack $ show editId) <> "该文章不存在") $ (isJust mPArtice)
  upKey <- lift $ runDB $ update upKey [ArticleTitle =. title ,
                                        ArticleContext =. context,
                                        ArticleOwnerCateId =. pid,
                                        ArticleIsPrivate =. isPrivate]
  return editId

eu2tp::Entity Article -> (Int64,Article)
eu2tp (Entity k v) = (fromSqlKey  k,v)

filterPrivateArticle :: Maybe Int64 -> [Filter Article]
filterPrivateArticle =  maybe [ArticleIsPrivate==.False] (\x -> [ArticleOwnerUserId==.x,ArticleIsPrivate==.True] ||. [ArticleIsPrivate ==. False])

queryArticle::(SqlDB m) => Maybe Int64 -> [Filter Article] -> [SelectOpt Article]  -> PageInfo -> m (Table (Int64,Article))
queryArticle mayUserId flist slist pi@(PageInfo cp ps) = do
  userCount <- runDB $ count (flist::[Filter Article])
  let filterPrivate =  filterPrivateArticle mayUserId
  userList::[Entity Article] <- runDB $ selectList (filterPrivate <> flist) ([LimitTo ps,OffsetBy (cp * ps)] <> slist)
  return $ Table {total = userCount,pageInfo = pi,tableData = (map eu2tp userList)}

queryArticleList::(SqlDB m) => Maybe Int64 -> Int -> [Filter Article] -> m [(Int64,Article)]
queryArticleList userId queryLen flist = do
  alist <- queryArticle userId flist [Desc ArticleCreateTime]  $ PageInfo 0 queryLen
  return $ tableData alist

deleteArticle::(SqlDB m) => Int64 -> m ()
deleteArticle delId = do
  let delKey::Key Article = toSqlKey delId
  runDB $ delete delKey
  return ()

getArticle::(SqlDB m) => Maybe Int64 -> Int64 -> m (Either T.Text (Int64,Article))
getArticle mayUserId articleId = runExceptT $ do
   let sqlKey::Key Article = toSqlKey articleId
   mArticle <- lift $ runDB $ get sqlKey
   case mArticle of
     Nothing -> throwE "不存在的articleId"
     Just ea  ->  if isCanShowArticle mayUserId ea
                  then return $ (articleId,ea)
                  else throwE "不存在的articleId"
{-
getArticleHTML::(SqlDB m) => Int64 -> m (Either T.Text (Int64,Article))
getArticleHTML articleId =  do
  ret <- getArticle articleId
  let (id,Article title ctx cid cTime) = fromRight undefined ret
  pdocRet <- liftIO $ TP.runIO $ do
                           pdoc <- TP.readMarkdown def ctx
                           txt  <- TP.writeS5 def pdoc
                           return txt
  case pdocRet of
    Left l  -> return $ Left $ T.pack $ show l
    Right r -> return $ Right (id,Article title r cid cTime)
-}

getNewsArticle::(SqlDB m) => Maybe Int64 -> Int64 -> m [(Int64,Article)]
getNewsArticle mayUserId nums = do
  let filterPrivate = filterPrivateArticle mayUserId
  lst::[Entity Article] <- runDB $ selectList filterPrivate [Desc ArticleCreateTime,LimitTo $ fromIntegral nums]
  return $ map eu2tp lst

isCanShowArticle::Maybe Int64 -> Article -> Bool
isCanShowArticle Nothing Article{..} = not articleIsPrivate
isCanShowArticle (Just uid) Article{..} = (not articleIsPrivate) ||
                                          (articleIsPrivate && (uid == articleOwnerUserId))